home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / misc / gs261src.zip / iscan.c < prev    next >
C/C++ Source or Header  |  1993-05-20  |  31KB  |  1,058 lines
  1. /* Copyright (C) 1989, 1992, 1993 Aladdin Enterprises.  All rights reserved.
  2.  
  3. This file is part of Ghostscript.
  4.  
  5. Ghostscript is distributed in the hope that it will be useful, but
  6. WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  7. to anyone for the consequences of using it or for whether it serves any
  8. particular purpose or works at all, unless he says so in writing.  Refer
  9. to the Ghostscript General Public License for full details.
  10.  
  11. Everyone is granted permission to copy, modify and redistribute
  12. Ghostscript, but only under the conditions described in the Ghostscript
  13. General Public License.  A copy of this license is supposed to have been
  14. given to you along with Ghostscript so you can know your rights and
  15. responsibilities.  It should be in a file named COPYING.  Among other
  16. things, the copyright notice and this notice must be preserved on all
  17. copies.  */
  18.  
  19. /* iscan.c */
  20. /* Token scanner for Ghostscript interpreter */
  21. #include "ghost.h"
  22. #include "ctype_.h"
  23. #include "memory_.h"
  24. #include "stream.h"
  25. #include "alloc.h"
  26. #include "dict.h"            /* for //name lookup */
  27. #include "dstack.h"            /* ditto */
  28. #include "errors.h"
  29. #include "ilevel.h"
  30. #include "iname.h"
  31. #include "iscan.h"            /* defines interface */
  32. #include "iutil.h"
  33. #include "ivmspace.h"
  34. #include "ostack.h"            /* for accumulating proc bodies */
  35. #include "packed.h"
  36. #include "store.h"
  37. #include "scanchar.h"
  38.  
  39. /* Array packing flag */
  40. ref ref_array_packing;            /* t_boolean */
  41. /* Binary object format flag. This will never be set non-zero */
  42. /* unless the binary token feature is enabled. */
  43. ref ref_binary_object_format;        /* t_integer */
  44. #define recognize_btokens()\
  45.   (ref_binary_object_format.value.intval != 0 && level2_enabled)
  46.  
  47. /* Procedure for binary tokens.  Set at initialization if Level 2 */
  48. /* features are included; only called if recognize_btokens() is true. */
  49. /* Returns 0 or scan_BOS on success, <0 on failure. */
  50. int (*scan_btoken_proc)(P3(stream *, ref *, int)) = NULL;
  51.  
  52. /* Setup procedure for ASCII85 literals.  Set at initialization if Level 2 */
  53. /* features are included. */
  54. void (*scan_ascii85_setup_proc)(P4(stream *, stream *, byte *, uint)) = NULL;
  55.  
  56. /*
  57.  * Level 2 includes some changes in the scanner:
  58.  *    - \ is always recognized in strings, regardless of the data source;
  59.  *    - << and >> are legal tokens;
  60.  *    - <~ introduces an ASCII85 encoded string (terminated by ~>);
  61.  *    - Character codes above 127 introduce binary objects.
  62.  * We explicitly enable or disable these changes here.
  63.  */
  64. #define scan_enable_level2 level2_enabled    /* from ilevel.h */
  65.  
  66. /* Forward references */
  67. private    int    scan_ascii85_string(P2(stream *, ref *)),
  68.         scan_hex_string(P2(stream *, ref *)),
  69.         scan_int(P6(const byte **, const byte *, int, int,
  70.                 long *, double *)),
  71.         scan_number(P3(const byte *, const byte *, ref *)),
  72.         scan_string(P3(stream *, int, ref *));
  73.  
  74. /* Define the character scanning table (see scanchar.h). */
  75. byte scan_char_array[258];
  76.  
  77. /* A structure for dynamically growable objects */
  78. typedef struct dynamic_area_s {
  79.     byte *base;
  80.     byte *next;
  81.     uint num_elts;
  82.     uint elt_size;
  83.     int is_dynamic;            /* false if using fixed buffer */
  84.     byte *limit;
  85. } dynamic_area;
  86. typedef dynamic_area _ss *da_ptr;
  87.  
  88. /* Begin a dynamic object. */
  89. /* dynamic_begin returns the value of alloc, which may be 0: */
  90. /* the invoker of dynamic_begin must test the value against 0. */
  91. #define dynamic_begin(pda, dnum, desize)\
  92.     ((pda)->base = (byte *)alloc((pda)->num_elts = (dnum),\
  93.                      (pda)->elt_size = (desize), "scanner"),\
  94.      (pda)->limit = (pda)->base + (dnum) * (desize),\
  95.      (pda)->is_dynamic = 1,\
  96.      (pda)->next = (pda)->base)
  97. /* Begin a dynamically allocated string in a static buffer. */
  98. #define static_begin_string(pda, count, buf)\
  99.     ((pda)->num_elts = (count),\
  100.      (pda)->elt_size = 1,\
  101.      (pda)->is_dynamic = 0,\
  102.      (pda)->limit = (buf) + (count),\
  103.      (pda)->next = (pda)->base = (buf))
  104.  
  105. /* Free a dynamic object. */
  106. private void
  107. dynamic_free(da_ptr pda)
  108. {    if ( pda->is_dynamic )
  109.         alloc_free((char *)(pda->base), pda->num_elts, pda->elt_size,
  110.                "scanner");
  111. }
  112.  
  113. /* Grow a dynamic object. */
  114. /* If the allocation fails, free the old contents, and return NULL; */
  115. /* otherwise, return the new `next' pointer. */
  116. private byte *
  117. dynamic_grow(register da_ptr pda, byte *next)
  118. {    if ( next != pda->limit ) return next;
  119.     pda->next = next;
  120.        {    uint num = pda->num_elts;
  121.         uint old_size = num * pda->elt_size;
  122.         uint pos = pda->next - pda->base;
  123.         uint new_size = (old_size < 10 ? 20 :
  124.                  old_size >= (max_uint >> 1) ? max_uint :
  125.                  old_size << 1);
  126.         uint new_num = new_size / pda->elt_size;
  127.         if ( pda->is_dynamic )
  128.            {    byte *base = alloc_grow(pda->base, num, new_num, pda->elt_size, "scanner");
  129.             if ( base == 0 )
  130.                {    dynamic_free(pda);
  131.                 return NULL;
  132.                }
  133.             pda->base = base;
  134.             pda->num_elts = new_num;
  135.             pda->limit = pda->base + new_size;
  136.            }
  137.         else
  138.            {    byte *base = pda->base;
  139.             if ( !dynamic_begin(pda, new_num, pda->elt_size) ) return NULL;
  140.             memcpy(pda->base, base, old_size);
  141.             pda->is_dynamic = 1;
  142.            }
  143.         pda->next = pda->base + pos;
  144.        }
  145.     return pda->next;
  146. }
  147.  
  148. /* Initialize the scanner. */
  149. void
  150. scan_init(void)
  151. {    /* Initialize decoder array */
  152.     register byte _ds *decoder = scan_char_decoder;
  153.     static const char _ds *stop_chars = "()<>[]{}/%";
  154.     static const char _ds *space_chars = " \f\t\n\r";
  155.     decoder[ERRC] = ctype_eof;    /* ****** FIX THIS? ****** */
  156.     decoder[EOFC] = ctype_eof;
  157.     memset(decoder, ctype_name, 256);
  158.     memset(decoder + 128, ctype_btoken, 32);
  159.        {    register const char _ds *p;
  160.         for ( p = space_chars; *p; p++ )
  161.           decoder[*p] = ctype_space;
  162.         decoder[char_NULL] = decoder[char_VT] =
  163.           decoder[char_DOS_EOF] = ctype_space;
  164.         for ( p = stop_chars; *p; p++ )
  165.           decoder[*p] = ctype_other;
  166.        }
  167.        {    register int i;
  168.         for ( i = 0; i < 10; i++ )
  169.           decoder['0' + i] = i;
  170.         for ( i = 0; i < max_radix - 10; i++ )
  171.           decoder['A' + i] = decoder['a' + i] = i + 10;
  172.        }
  173.     /* Other initialization */
  174.     make_false(&ref_array_packing);
  175.     make_int(&ref_binary_object_format, 0);
  176. }
  177.  
  178. /*
  179.  * Read a token from a stream.
  180.  * Return 1 for end-of-stream, 0 if a token was read,
  181.  * or a (negative) error code.
  182.  * If the token required a terminating character (i.e., was a name or
  183.  * number) and the next character was whitespace, read and discard
  184.  * that character: see the description of the 'token' operator on
  185.  * p. 232 of the Red Book (First Edition).
  186.  * from_string indicates reading from a string vs. a file,
  187.  * because Level 1 interpreters ignore \ escapes in the former case.
  188.  * (See the footnote on p. 23 of the Red Book.)
  189.  */
  190. int
  191. scan_token(register stream *s, int from_string, ref *pref)
  192. {    ref *myref = pref;
  193.     dynamic_area proc_da;    /* (not actually dynamic) */
  194.     int pstack = 0;        /* offset from proc_da.base */
  195.     int retcode = 0;
  196.     register int c;
  197.     s_declare_inline(s, sptr, endptr);
  198. #define sreturn(code)\
  199.   { s_end_inline(s, sptr, endptr); return_error(code); }
  200. #define sreturn_no_error(code)\
  201.   { s_end_inline(s, sptr, endptr); return(code); }
  202.     int name_type;        /* number of /'s preceding */
  203.     int max_name_ctype =
  204.         (recognize_btokens() ? ctype_name : ctype_btoken);
  205.     int try_number;
  206.     byte s1[2];
  207.     register byte _ds *decoder = scan_char_decoder;
  208.     s_begin_inline(s, sptr, endptr);
  209. top:    c = sgetc_inline(s, sptr, endptr);
  210. #ifdef DEBUG
  211. if ( gs_debug['s'] )
  212.     fprintf(gs_debug_out, (c >= 32 && c <= 126 ? "`%c'" : "`%03o'"), c);
  213. #endif
  214.     switch ( c )
  215.        {
  216.     case ' ': case '\f': case '\t': case '\n': case '\r':
  217.     case char_NULL: case char_VT: case char_DOS_EOF:
  218.         goto top;
  219.     case '[':
  220.     case ']':
  221.         s1[0] = (byte)c;
  222.         name_ref(s1, 1, myref, 1);
  223.         r_set_attrs(myref, a_executable);
  224.         break;
  225.     case '<':
  226.         if ( scan_enable_level2 )
  227.            {    c = sgetc_inline(s, sptr, endptr);
  228.             switch ( c )
  229.                {
  230.             case '<':
  231.                 sputback_inline(s, sptr, endptr);
  232.                 name_type = try_number = 0;
  233.                 goto try_funny_name;
  234.             case '~':
  235.                 s_end_inline(s, sptr, endptr);
  236.                 retcode = scan_ascii85_string(s, myref);
  237.                 goto sx;
  238.                }
  239.             if ( char_is_data(c) )
  240.                 sputback_inline(s, sptr, endptr);
  241.            }
  242.         s_end_inline(s, sptr, endptr);
  243.         retcode = scan_hex_string(s, myref);
  244. sx:        s_begin_inline(s, sptr, endptr);
  245.         break;
  246.     case '(':
  247.         s_end_inline(s, sptr, endptr);
  248.         retcode = scan_string(s, from_string, myref);
  249.         s_begin_inline(s, sptr, endptr);
  250.         break;
  251.     case '{':
  252.         if ( pstack == 0 )
  253.            {    /* Use the operand stack to accumulate procedures. */
  254.             myref = osp + 1;
  255.             proc_da.base = (byte *)myref;
  256.             proc_da.limit = (byte *)(ostop + 1);
  257.             proc_da.is_dynamic = 0;
  258.             proc_da.elt_size = sizeof(ref);
  259.             proc_da.num_elts = ostop - osp;
  260.            }
  261.         if ( proc_da.limit - (byte *)myref < 2 * sizeof(ref) )
  262.           sreturn(e_limitcheck); /* ****** SHOULD GROW OSTACK ****** */
  263.         r_set_size(myref, pstack);
  264.         myref++;
  265.         pstack = (byte *)myref - proc_da.base;
  266.         goto top;
  267.     case '>':
  268.         if ( scan_enable_level2 )
  269.            {    name_type = try_number = 0;
  270.             goto try_funny_name;
  271.            }
  272.         /* falls through */
  273.     case ')':
  274.         retcode = e_syntaxerror;
  275.         break;
  276.     case '}':
  277.         if ( pstack == 0 )
  278.            {    retcode = e_syntaxerror;
  279.             break;    
  280.            }
  281.            {    ref *ref0 = (ref *)(proc_da.base + pstack);
  282.             uint size = myref - ref0;
  283.             myref = ref0 - 1;
  284.             pstack = r_size(myref);
  285.             if ( pstack == 0 ) myref = pref;
  286.             if ( ref_array_packing.value.index )
  287.                {    retcode = make_packed_array(ref0, size, myref,
  288.                                 "scanner(packed)");
  289.                 if ( retcode < 0 )
  290.                     sreturn(retcode);
  291.                 r_set_attrs(myref, a_executable);
  292.                }
  293.             else
  294.             {    retcode = alloc_array(myref, a_executable + a_all, size, "scanner(proc)");
  295.                 if ( retcode < 0 )
  296.                     sreturn(retcode);
  297.                 refcpy_to_new(myref->value.refs, ref0, size);
  298.               }
  299.            }
  300.         break;
  301.     case '/':
  302.         c = sgetc_inline(s, sptr, endptr);
  303.         if ( c == '/' )
  304.            {    name_type = 2;
  305.             c = sgetc_inline(s, sptr, endptr);
  306.            }
  307.         else
  308.             name_type = 1;
  309.         try_number = 0;
  310.         switch ( decoder[c] )
  311.            {
  312.         case ctype_name:
  313.         default:
  314.             goto do_name;
  315.         case ctype_btoken:
  316.             if ( !recognize_btokens() ) goto do_name;
  317.             /* otherwise, an empty name */
  318.             sputback_inline(s, sptr, endptr);
  319.         case ctype_eof:
  320.             /* Empty name: bizarre but legitimate. */
  321.             name_ref((byte *)0, 0, myref, 1);
  322.             goto have_name;
  323.         case ctype_other:
  324.             switch ( c )
  325.                {
  326.             case '[':    /* only special as first character */
  327.             case ']':    /* ditto */
  328.                 s1[0] = (byte)c;
  329.                 name_ref(s1, 1, myref, 1);
  330.                 goto have_name;
  331.             case '<':    /* legal in Level 2 */
  332.             case '>':
  333.                 if ( scan_enable_level2 ) goto try_funny_name;
  334.             default:
  335.                 /* Empty name: bizarre but legitimate. */
  336.                 name_ref((byte *)0, 0, myref, 1);
  337.                 sputback_inline(s, sptr, endptr);
  338.                 goto have_name;
  339.                }
  340.         case ctype_space:
  341.             /* Empty name: bizarre but legitimate. */
  342.             name_ref((byte *)0, 0, myref, 1);
  343.             /* Check for \r\n */
  344.             if ( c == '\r' && (c = sgetc_inline(s, sptr, endptr)) != '\n' && char_is_data(c) )
  345.                 sputback_inline(s, sptr, endptr);
  346.             goto have_name;
  347.            }
  348.         /* NOTREACHED */
  349.     case '%':
  350.        {    for ( ; ; )
  351.           switch ( sgetc_inline(s, sptr, endptr) )
  352.            {
  353.         case '\r':
  354.             if ( (c = sgetc_inline(s, sptr, endptr)) != '\n' && char_is_data(c) )
  355.                 sputback_inline(s, sptr, endptr);
  356.             /* falls through */
  357.         case '\n': case '\f':
  358.             goto top;
  359.         case EOFC:
  360.             goto ceof;
  361.         case ERRC:
  362.             goto cerr;
  363.            }
  364. ceof:        ;
  365.        }    /* falls through */
  366.     case EOFC:
  367.         retcode = (pstack != 0 ? e_syntaxerror : scan_EOF);
  368.         break;
  369.     case ERRC:
  370. cerr:        retcode = e_ioerror;
  371.         break;
  372.  
  373.     /* Check for a Level 2 funny name (<< or >>). */
  374.     /* c is '<' or '>'. */
  375. try_funny_name:
  376.        {    int c1 = sgetc_inline(s, sptr, endptr);
  377.         if ( c1 == c )
  378.            {    s1[0] = s1[1] = c;
  379.             retcode = name_ref(s1, 2, myref, 1);
  380.             goto have_name;
  381.            }
  382.         if ( char_is_data(c1) ) sputback_inline(s, sptr, endptr);
  383.        }    retcode = e_syntaxerror;
  384.         break;
  385.  
  386.     /* Handle separately the names that might be a number. */
  387.     case '0': case '1': case '2': case '3': case '4':
  388.     case '5': case '6': case '7': case '8': case '9':
  389.     /* We have special fast code for unsigned integers up to 4 digits, */
  390.     /* because these account for a very large proportion of */
  391.     /* all numbers found in PostScript files. */
  392.         if ( sbufavailable_inline(s, sptr, endptr) >= 6 )
  393.         {    /* Worst case: 4 digits, \r, \n */
  394.             int i = decoder[c];
  395.             int d;
  396. #define char_is_digit(ch)\
  397.  ((d = decoder[ch]) < 10)
  398.             if ( !char_is_digit(sptr[1]) )
  399.             {    if ( d != ctype_space )
  400.                     goto nn;
  401.                 sptr++;
  402.                 goto endi;
  403.             }
  404.             i = i * 10 + d;
  405.             if ( !char_is_digit(sptr[2]) )
  406.             {    if ( d != ctype_space )
  407.                     goto nn;
  408.                 sptr += 2;
  409.                 goto endi;
  410.             }
  411.             i = i * 10 + d;
  412.             if ( !char_is_digit(sptr[3]) )
  413.             {    if ( d != ctype_space )
  414.                     goto nn;
  415.                 sptr += 3;
  416.                 goto endi;
  417.             }
  418.             if ( decoder[sptr[4]] != ctype_space )
  419.                 goto nn;
  420.             i = i * 10 + d;
  421.             sptr += 4;
  422. endi:            /* Check for \r\n */
  423.             if ( *sptr == '\r' && sptr[1] == '\n' )
  424.                 sptr++;
  425.             make_int_new(myref, i);
  426.             break;
  427. #undef char_is_digit
  428.         }
  429.     /* Handle general possible-numbers. */
  430.     case '.': case '+': case '-':
  431. nn:        name_type = 0;
  432.         try_number = 1;
  433.         goto do_name;
  434.  
  435.     /* Check for a binary object */
  436. #define case4(c) case c: case c+1: case c+2: case c+3
  437.     case4(128): case4(132): case4(136): case4(140):
  438.     case4(144): case4(148): case4(152): case4(156):
  439. #undef case4
  440.         if ( recognize_btokens() )
  441.            {    s_end_inline(s, sptr, endptr);
  442.             retcode = (*scan_btoken_proc)(s, myref, c);
  443.             s_begin_inline(s, sptr, endptr);
  444.             break;
  445.            }
  446.     /* Not a binary object, fall through. */
  447.  
  448.     /* The default is a name. */
  449.     default:
  450.     /* Populate the switch with enough cases to force */
  451.     /* simple compilers to use a dispatch rather than tests. */
  452.     case '!': case '"': case '#': case '$': case '&': case '\'':
  453.     case '*': case ',': case '=': case ':': case ';': case '?': case '@':
  454.     case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
  455.     case 'G': case 'H': case 'I': case 'J': case 'K': case 'L': case 'M':
  456.     case 'N': case 'O': case 'P': case 'Q': case 'R': case 'S':
  457.     case 'T': case 'U': case 'V': case 'W': case 'X': case 'Y': case 'Z':
  458.     case '\\': case '^': case '_': case '`':
  459.     case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
  460.     case 'g': case 'h': case 'i': case 'j': case 'k': case 'l': case 'm':
  461.     case 'n': case 'o': case 'p': case 'q': case 'r': case 's':
  462.     case 't': case 'u': case 'v': case 'w': case 'x': case 'y': case 'z':
  463.     case '|': case '~':
  464.         /* Common code for scanning a name. */
  465.         /* try_number and name_type are already set. */
  466.         /* We know c has ctype_name (or maybe ctype_btoken) */
  467.         /* or is a digit. */
  468.         name_type = 0;
  469.         try_number = 0;
  470. do_name:
  471.        {    dynamic_area da;
  472.         /* Try to scan entirely within the stream buffer. */
  473.         /* We stop 1 character early, so we don't switch buffers */
  474.         /* looking ahead if the name is terminated by \r\n. */
  475.         byte *ptr;
  476.         byte *endp1 = endptr - 1;
  477.         da.base = sptr;
  478.         da.is_dynamic = 0;
  479.         do
  480.         {    if ( sptr >= endp1 )    /* stop 1 early! */
  481.                 goto dyn_name;
  482.         }
  483.         while ( decoder[*++sptr] <= max_name_ctype );    /* digit or name */
  484.         /* Name ended within the buffer. */
  485.         ptr = sptr;
  486.         c = *sptr;
  487.         goto nx;
  488. dyn_name:    /* Name extended past end of buffer. */
  489.         s_end_inline(s, sptr, endptr);
  490.         /* Initialize the dynamic area. */
  491.         /* We have to do this before the next */
  492.         /* sgetc, which will overwrite the buffer. */
  493.         da.limit = ++sptr;
  494.         da.num_elts = sptr - da.base;
  495.         da.elt_size = 1;
  496.         ptr = dynamic_grow(&da, da.limit);
  497.         if ( !ptr )
  498.             sreturn(e_VMerror);
  499.         s_begin_inline(s, sptr, endptr);
  500.         while ( decoder[c = sgetc_inline(s, sptr, endptr)] <= max_name_ctype )
  501.           {    if ( ptr == da.limit )
  502.                {    ptr = dynamic_grow(&da, ptr);
  503.                 if ( !ptr )
  504.                     sreturn(e_VMerror);
  505.                }
  506.             *ptr++ = c;
  507.            }
  508. nx:        switch ( decoder[c] )
  509.           {
  510.           case ctype_btoken:
  511.           case ctype_other:
  512.             sputback_inline(s, sptr, endptr);
  513.             break;
  514.           case ctype_space:
  515.             /* Check for \r\n */
  516.             if ( c == '\r' && (c = sgetc_inline(s, sptr, endptr)) != '\n' && char_is_data(c) )
  517.                 sputback_inline(s, sptr, endptr);
  518.           case ctype_eof: ;
  519.           }
  520.         /* Check for a number */
  521.         if ( try_number )
  522.            {    retcode = scan_number(da.base, ptr, myref);
  523.             if ( retcode != e_syntaxerror )
  524.                {    dynamic_free(&da);
  525.                 if ( name_type == 2 )
  526.                     sreturn(e_syntaxerror);
  527.                 break;    /* might be e_limitcheck */
  528.                }
  529.            }
  530.         retcode = name_ref(da.base, (uint)(ptr - da.base), myref, 1);
  531.         dynamic_free(&da);
  532.        }
  533.         /* Done scanning.  Check for preceding /'s. */
  534. have_name:    if ( retcode < 0 )
  535.             sreturn(retcode);
  536.         switch ( name_type )
  537.            {
  538.         case 0:            /* ordinary executable name */
  539.             if ( r_has_type(myref, t_name) )    /* i.e., not a number */
  540.               r_set_attrs(myref, a_executable);
  541.         case 1:            /* quoted name */
  542.             break;
  543.         case 2:            /* immediate lookup */
  544.            {    ref *pvalue;
  545.             if ( !r_has_type(myref, t_name) )
  546.                 sreturn(e_undefined);
  547.             if ( (pvalue = dict_find_name(myref)) == 0 )
  548.                 sreturn(e_undefined);
  549.             if ( !r_is_global(pvalue) && pstack != 0 &&
  550.                  !alloc_current_local()
  551.                )
  552.                 sreturn(e_invalidaccess);
  553.             ref_assign_new(myref, pvalue);
  554.            }
  555.            }
  556.        }
  557.     if ( retcode < 0 )
  558.         sreturn(retcode);
  559.     /* If we are at the top level, return the object, */
  560.     /* otherwise keep going. */
  561.     if ( pstack == 0 )
  562.         sreturn_no_error(retcode);
  563.     if ( proc_da.limit - (byte *)myref < 2 * sizeof(ref) )
  564.         sreturn(e_limitcheck); /* ****** SHOULD GROW OSTACK ****** */
  565.     myref++;
  566.     goto top;
  567. }
  568.  
  569. /* The internal scanning procedures return 0 on success, */
  570. /* or a (negative) error code on failure. */
  571.  
  572. /* Scan a number for cvi or cvr. */
  573. /* The first argument is a t_string.  This is just like scan_number, */
  574. /* but allows leading or trailing whitespace. */
  575. int
  576. scan_number_only(const ref *psref, ref *pnref)
  577. {    const byte *str = psref->value.const_bytes;
  578.     const byte *end = str + r_size(psref);
  579.     if ( !r_has_attr(psref, a_read) )
  580.         return_error(e_invalidaccess);
  581.     while ( str < end && scan_char_decoder[*str] == ctype_space )
  582.       str++;
  583.     while ( str < end && scan_char_decoder[end[-1]] == ctype_space )
  584.       end--;
  585.     return scan_number(str, end, pnref);
  586. }
  587.  
  588. /* Note that the number scanning procedures use a byte ** and a byte * */
  589. /* rather than a stream.  (It makes quite a difference in performance.) */
  590. #define neof(sp) (sp >= end)
  591. #define ngetc(cvar, sp, exit) if ( neof(sp) ) { exit; } else cvar = *sp++
  592. #define nputback(sp) (--sp)
  593. #define nreturn(v) return (*pstr = sp, v)
  594.  
  595. /* Procedure to scan a number. */
  596. private int
  597. scan_number(const byte *str, const byte *end, ref *pref)
  598. {    /* Powers of 10 up to 6 can be represented accurately as */
  599.     /* a single-precision float. */
  600. #define num_powers_10 6
  601.     static const float powers_10[num_powers_10+1] =
  602.        {    1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6    };
  603.     static const double neg_powers_10[num_powers_10+1] =
  604.        {    1e0, 1e-1, 1e-2, 1e-3, 1e-4, 1e-5, 1e-6    };
  605.     const byte *sp = str;        /* can't be register because of & */
  606.     int sign;
  607.     long ival;
  608.     double dval;
  609.     int exp10;
  610.     int code;
  611.     register int c;
  612.     if ( neof(sp) )
  613.         return_error(e_syntaxerror);
  614.     switch ( *sp )
  615.     {
  616.     case '+': sign = 1; sp++; break;
  617.     case '-': sign = -1; sp++; break;
  618.     default: sign = 0;
  619.     }
  620.     if ( (code = scan_int(&sp, end, 10, 0, &ival, &dval)) != 0 )
  621.     {    if ( code < 0 )
  622.         {    /* We can't actually get a limitcheck yet, */
  623.             /* because we don't check for floating overflow. */
  624.             if ( code != e_syntaxerror )    /* e_limitcheck */
  625.                 return code;
  626.             /* Might be a number starting with '.'. */
  627.             /* We don't pre-check for this, because it's rare. */
  628.             ngetc(c, sp, return_error(e_syntaxerror));
  629.             if ( c != '.' )
  630.                 return_error(e_syntaxerror);
  631.             ngetc(c, sp, return_error(e_syntaxerror));
  632.             if ( !isdigit(c) )
  633.                 return_error(e_syntaxerror);
  634.             ival = 0;
  635.             goto fi;
  636.         }
  637.         /* Code == 1, i.e., the integer overflowed. */
  638. #define retreal()        /* return a float */\
  639.   make_real_new(pref, (float)(sign < 0 ? -dval : dval));\
  640.   return 0
  641.         ngetc(c, sp, retreal());
  642.         switch ( c )
  643.            {
  644.         default:
  645.             return_error(e_syntaxerror); /* not terminated properly */
  646.         case '.':
  647.             ngetc(c, sp, c = EOFC);
  648.             exp10 = 0;
  649.             goto fd;
  650.         case 'e': case 'E':
  651.             exp10 = 0;
  652.             goto fsd;
  653.         case ERRC:
  654.             return_error(e_ioerror);
  655.            }
  656.     }
  657.     ngetc(c, sp, goto ri);
  658.     switch ( c )
  659.     {
  660.     case ERRC:
  661.         return_error(e_ioerror);
  662.     case '.':
  663.         ngetc(c, sp, c = EOFC);
  664.         goto fi;
  665.     default:
  666.         return_error(e_syntaxerror);    /* not terminated properly */
  667.     case 'e': case 'E':
  668.         dval = (sign < 0 ? -ival : ival);
  669.         exp10 = 0;
  670.         goto fe;
  671.     case '#':
  672.         if ( sign || ival < min_radix || ival > max_radix )
  673.             return_error(e_syntaxerror);
  674.         code = scan_int(&sp, end, (int)ival, 1, &ival, NULL);
  675.         if ( code )
  676.             return code;
  677.         ngetc(c, sp, goto ri);
  678.         switch ( c )
  679.            {
  680.         case ERRC:
  681.             return_error(e_ioerror);
  682.         default:
  683.             return_error(e_syntaxerror);
  684.            }
  685.     }
  686. ri:    /* Return an integer */
  687.     make_int_new(pref, (sign < 0 ? -ival : ival));
  688.     return 0;
  689.     /* Handle a real.  We just saw the decimal point. */
  690.     /* Enter here if we are still accumulating an integer in ival. */
  691. fi:    exp10 = 0;
  692.     while ( isdigit(c) )
  693.        {    /* Check for overflowing ival */
  694.         if ( ival >= (max_ulong >> 1) / 10 - 1 )
  695.            {    dval = ival;
  696.             goto fd;
  697.            }
  698.         ival = ival * 10 + (c - '0');
  699.         exp10--;
  700.         ngetc(c, sp, c = EOFC);
  701.        }
  702.     if ( sign < 0 ) ival = -ival;
  703.     /* Take a shortcut for the common case */
  704.     if ( !(c == 'e' || c == 'E' || exp10 < -num_powers_10) )
  705.        {    /* Check for trailing garbage */
  706.         if ( c != EOFC ) return_error(e_syntaxerror);
  707.         make_real_new(pref, (float)(ival * neg_powers_10[-exp10]));
  708.         return 0;
  709.        }
  710.     dval = ival;
  711.     goto fe;
  712.     /* Now we are accumulating a double in dval. */
  713. fd:    while ( isdigit(c) )
  714.        {    dval = dval * 10 + (c - '0');
  715.         exp10--;
  716.         ngetc(c, sp, c = EOFC);
  717.        }
  718. fsd:    if ( sign < 0 ) dval = -dval;
  719. fe:    /* dval contains the value, negated if necessary */
  720.     if ( c == 'e' || c == 'E' )
  721.        {    /* Check for a following exponent. */
  722.         int esign = 0;
  723.         long eexp;
  724.         ngetc(c, sp, c = EOFC);
  725.         switch ( c )
  726.            {
  727.         case '+':
  728.             /* The following unnecessary assignment */
  729.             /* works around a bug in the bundled Sun compiler. */
  730.             esign = 0;
  731.             break;
  732.         case '-':
  733.             esign = 1;
  734.             break;
  735.         default:
  736.             nputback(sp);
  737.            }
  738.         code = scan_int(&sp, end, 10, 0, &eexp, NULL);
  739.         if ( code < 0 ) 
  740.             return code;
  741.         if ( code > 0 || eexp > 999 )
  742.             return_error(e_limitcheck);    /* semi-arbitrary */
  743.         if ( esign )
  744.             exp10 -= (int)eexp;
  745.         else
  746.             exp10 += (int)eexp;
  747.         ngetc(c, sp, c = EOFC);
  748.        }
  749.     if ( c != EOFC )
  750.         return_error((c == ERRC ? e_ioerror : e_syntaxerror));
  751.     /* Compute dval * 10^exp10. */
  752.     if ( exp10 > 0 )
  753.        {    while ( exp10 > num_powers_10 )
  754.             dval *= powers_10[num_powers_10],
  755.             exp10 -= num_powers_10;
  756.         if ( exp10 > 0 )
  757.             dval *= powers_10[exp10];
  758.        }
  759.     else if ( exp10 < 0 )
  760.        {    while ( exp10 < -num_powers_10 )
  761.             dval /= powers_10[num_powers_10],
  762.             exp10 += num_powers_10;
  763.         if ( exp10 < 0 )
  764.             dval /= powers_10[-exp10];
  765.        }
  766.     make_real_new(pref, (float)dval);
  767.     return 0;
  768. }
  769. /* Internal subroutine to scan an integer. */
  770. /* Return 0, e_limitcheck, or e_syntaxerror. */
  771. /* (The only syntax error is no digits encountered.) */
  772. /* Put back the terminating character. */
  773. /* If nosign is true, the integer is scanned as unsigned; */
  774. /* overflowing a ulong returns e_limitcheck.  If nosign is false, */
  775. /* the integer is scanned as signed; if the integer won't fit in a long, */
  776. /* then: */
  777. /*   if pdval == NULL, return e_limitcheck; */
  778. /*   if pdval != NULL, return 1 and store a double value in *pdval. */
  779. private int
  780. scan_int(const byte **pstr, const byte *end, int radix, int nosign,
  781.   long *pval, double *pdval)
  782. {    register const byte *sp = *pstr;
  783.     uint ival;
  784.     ulong lval, lmax;
  785.     uint lrem;
  786.     double dval;
  787.     register int c, d;
  788.     register byte _ds *decoder = scan_char_decoder;
  789. #define convert_digit_fails(c, d)\
  790.   (d = decoder[c]) >= radix
  791.     ngetc(c, sp, return_error(e_syntaxerror));
  792.     if ( convert_digit_fails(c, d) )
  793.         return_error(e_syntaxerror);
  794.     ival = d;
  795.     /* Pick up numbers up to 4 digits quickly. */
  796.     if ( radix <= 16 )
  797.     {    ngetc(c, sp, goto out);
  798.         if ( convert_digit_fails(c, d) )
  799.             goto pb;
  800.         ival = ival * radix + d;
  801.         ngetc(c, sp, goto out);
  802.         if ( convert_digit_fails(c, d) )
  803.             goto pb;
  804.         ival = ival * radix + d;
  805.         ngetc(c, sp, goto out);
  806.         if ( convert_digit_fails(c, d) )
  807.             goto pb;
  808.         ival = ival * radix + d;
  809.         if ( neof(sp) )
  810.         {
  811. #if arch_ints_are_short
  812.             /* 4 digits might overflow into the sign bit */
  813.             /* if radix == 16.  Check for this now. */
  814.             if ( (int)ival < 0 && !nosign )
  815.             {    /* Value overflowed into the sign bit, */
  816.                 /* but is still OK.  The VMS compiler */
  817.                 /* doesn't widen unsigneds to longs */
  818.                 /* correctly, so we do an extra assignment. */
  819.                 /* We know that the value fits into a long. */
  820.                 lval = ival;
  821.                 *pval = (long)lval;
  822.                 nreturn(0);
  823.             }
  824. #endif
  825.             goto out;
  826.         }
  827.     }
  828.  
  829.     /* More than 4 digits, or very large radix. */
  830.     /* Accumulate the value in a long. */
  831.     /* Avoid the long divisions when radix = 10. */
  832.     lval = ival;
  833.     if ( radix == 10 )        /* Avoid the divides */
  834.         lmax = max_ulong / 10, lrem = max_ulong % 10;
  835.     else
  836.         lmax = max_ulong / radix, lrem = max_ulong % radix;
  837.     while ( 1 )
  838.        {    ngetc(c, sp, goto l_end);
  839.         if ( convert_digit_fails(c, d) )
  840.             goto l_pb;
  841.         if ( lval >= lmax && (lval > lmax || d > lrem) )
  842.             goto l_over;        /* overflow */
  843.         lval = lval * radix + d;
  844.        }
  845.  
  846.     /* End of short integer. */
  847. pb:    if ( char_is_data(c) ) nputback(sp);
  848. out:    *pval = ival;
  849.     nreturn(0);
  850.  
  851.     /* End of long integer */
  852. l_pb:    if ( char_is_data(c) ) nputback(sp);
  853. l_end:    if ( (long)lval < 0 && !nosign )
  854.        {    d = lval % radix;
  855.         lval /= radix;
  856.         goto l_over;
  857.        }
  858.     *pval = lval;
  859.     nreturn(0);
  860.  
  861. l_over:    /* Integer overflowed.  Accumulate the result as a double. */
  862.     if ( pdval == NULL )
  863.         nreturn(e_limitcheck);
  864.     dval = (double)lval * radix + d;
  865.     while ( 1 )
  866.     {    ngetc(c, sp, break);
  867.         if ( convert_digit_fails(c, d) )
  868.         {    if ( char_is_data(c) ) nputback(sp);
  869.             break;
  870.         }
  871.         dval = dval * radix + d;
  872.     }
  873.  
  874.     /* End of very large integer. */
  875.     *pdval = dval;
  876.     nreturn(1);
  877. }
  878.  
  879. /* Make a string.  If the allocation fails, release any dynamic storage. */
  880. private int
  881. mk_string(ref *pref, da_ptr pda, byte *next)
  882. {    uint size = (pda->next = next) - pda->base;
  883.     byte *body;
  884.     if ( pda->is_dynamic )
  885.     {    body = alloc_shrink(pda->base, pda->num_elts, size, 1,
  886.                     "scanner(string)");
  887.         if ( body == 0 )
  888.         {    dynamic_free(pda);
  889.             return_error(e_VMerror);
  890.         }
  891.     }
  892.     else
  893.     {    body = (byte *)alloc(size, 1, "scanner(string)");
  894.         if ( body == 0 )
  895.             return_error(e_VMerror);
  896.         memcpy(body, pda->base, size);
  897.     }
  898.     make_tasv_new(pref, t_string, a_all, size, bytes, body);
  899.     return 0;
  900. }
  901.  
  902. /* Internal procedure to scan a string. */
  903. private int
  904. scan_string(register stream *s, int from_string, ref *pref)
  905. {    dynamic_area da;
  906.     register int c;
  907. #define str_count 50
  908.     byte str[str_count];        /* faster buffer for short strings */
  909.     register byte *ptr = static_begin_string(&da, str_count, str);
  910. #undef str_count
  911.     int plevel = 0;
  912. top:    while ( 1 )
  913.        {    switch ( (c = sgetc(s)) )
  914.            {
  915.         case EOFC:
  916.             dynamic_free(&da);
  917.             return_error(e_syntaxerror);
  918.         case ERRC:
  919.             dynamic_free(&da);
  920.             return_error(e_ioerror);
  921.         case '\\':
  922.             /* Only old P*stScr*pt interpreters use from_string.... */
  923.             if ( from_string && !scan_enable_level2 ) break;
  924.             switch ( (c = sgetc(s)) )
  925.                {
  926.             case 'n': c = '\n'; break;
  927.             case 'r': c = '\r'; break;
  928.             case 't': c = '\t'; break;
  929.             case 'b': c = '\b'; break;
  930.             case 'f': c = '\f'; break;
  931.             case '\r':    /* ignore, check for following \n */
  932.                 c = sgetc(s);
  933.                 if ( c != '\n' && char_is_data(c) )
  934.                     sputback(s);
  935.                 goto top;
  936.             case '\n': goto top;    /* ignore */
  937.             case '0': case '1': case '2': case '3':
  938.             case '4': case '5': case '6': case '7':
  939.                {    int d = sgetc(s);
  940.                 c -= '0';
  941.                 if ( d >= '0' && d <= '7' )
  942.                    {    c = (c << 3) + d - '0';
  943.                     d = sgetc(s);
  944.                     if ( d >= '0' && d <= '7' )
  945.                        {    c = (c << 3) + d - '0';
  946.                         break;
  947.                        }
  948.                    }
  949.                 if ( char_is_signal(d) )
  950.                    {    dynamic_free(&da);
  951.                     return (d == ERRC ? e_ioerror : e_syntaxerror);
  952.                    }
  953.                 sputback(s);
  954.                }
  955.                 break;
  956.             default: ;    /* ignore the \ */
  957.                }
  958.             break;
  959.         case '(':
  960.             plevel++; break;
  961.         case ')':
  962.             if ( --plevel < 0 ) goto out; break;
  963.         case '\r':        /* convert to \n */
  964.             c = sgetc(s);
  965.             if ( c != '\n' && char_is_data(c) )
  966.                 sputback(s);
  967.             c = '\n';
  968.            }
  969.         if ( ptr == da.limit )
  970.            {    ptr = dynamic_grow(&da, ptr);
  971.             if ( !ptr )
  972.                 return_error(e_VMerror);
  973.            }
  974.         *ptr++ = c;
  975.        }
  976. out:    return mk_string(pref, &da, ptr);
  977. }
  978.  
  979. /* Internal procedure to scan an ASCII85 string. */
  980. private int
  981. scan_ascii85_string(stream *s, ref *pref)
  982. {    dynamic_area da;
  983.     stream ss;
  984. #define buf85_size 128
  985.     byte buf85[buf85_size];
  986.     int c;
  987. #define str_count 50
  988.     byte str[str_count];        /* faster buffer for short strings */
  989.     byte *ptr = static_begin_string(&da, str_count, str);
  990. #undef str_count
  991.     if ( ptr == 0 )
  992.         return_error(e_VMerror);
  993.     (*scan_ascii85_setup_proc)(&ss, s, &buf85[0], buf85_size);
  994.     while ( (c = sgetc(&ss)) >= 0 )
  995.     {    if ( ptr == da.limit )
  996.            {    ptr = dynamic_grow(&da, ptr);
  997.             if ( !ptr )
  998.                 return_error(e_VMerror);
  999.            }
  1000.         *ptr++ = c;
  1001.     }
  1002.     if ( c != EOFC )
  1003.        {    dynamic_free(&da);
  1004.         return_error(e_syntaxerror);
  1005.        }
  1006.     return mk_string(pref, &da, ptr);
  1007. #undef buf85_size
  1008. }
  1009.  
  1010. /* Internal procedure to scan a hex string. */
  1011. private int
  1012. scan_hex_string(stream *s, ref *pref)
  1013. {    dynamic_area da;
  1014.     int c1, c2, val1, val2;
  1015. #define str_count 50
  1016.     byte str[str_count];        /* faster buffer for short strings */
  1017.     byte *ptr = static_begin_string(&da, str_count, str);
  1018. #undef str_count
  1019.     register const byte _ds *decoder = scan_char_decoder;
  1020.     if ( ptr == 0 )
  1021.         return_error(e_VMerror);
  1022. l1:    do
  1023.        {    c1 = sgetc(s);
  1024.         if ( (val1 = decoder[c1]) < 0x10 )
  1025.            {    do
  1026.                {    c2 = sgetc(s);
  1027.                 if ( (val2 = decoder[c2]) < 0x10 )
  1028.                    {    if ( ptr == da.limit )
  1029.                        {    ptr = dynamic_grow(&da, ptr);
  1030.                         if ( !ptr )
  1031.                             return_error(e_VMerror);
  1032.                        }
  1033.                     *ptr++ = (val1 << 4) + val2;
  1034.                     goto l1;
  1035.                    }
  1036.                }
  1037.             while ( val2 == ctype_space );
  1038.             if ( c2 != '>' )
  1039.                {    dynamic_free(&da);
  1040.                 return_error(e_syntaxerror);
  1041.                }
  1042.             if ( ptr == da.limit )
  1043.                {    ptr = dynamic_grow(&da, ptr);
  1044.                 if ( !ptr )
  1045.                     return_error(e_VMerror);
  1046.                }
  1047.             *ptr++ = val1 << 4;    /* no 2nd char */
  1048.             goto lx;
  1049.            }
  1050.        }
  1051.     while ( val1 == ctype_space );
  1052.     if ( c1 != '>' )
  1053.        {    dynamic_free(&da);
  1054.         return_error(e_syntaxerror);
  1055.        }
  1056. lx:    return mk_string(pref, &da, ptr);
  1057. }
  1058.